home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / SYSOP3.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  25KB  |  663 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-11-88 7:35 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit Sysop3;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TAccess, TPSTRING, TPDOS,
  19.   Exdate, Core1, Core2, Dirs, EditUsr1, Sysop1,
  20.   Msgentr, MsgMove, MsgRead;
  21.   
  22.   
  23. procedure process_macro;
  24.  
  25. procedure process_newin;
  26.  
  27. procedure move_from_newin;
  28.  
  29.  
  30.   {==========================================================================}
  31.   
  32.   
  33. Implementation
  34.  
  35.  
  36.  
  37.   procedure process_macro;
  38.     { Process sysop macro }
  39.     
  40.   var
  41.     done, continue  : Boolean;
  42.     ed_macro        : StrStd;
  43.     ch              : Char;
  44.     i               : Integer;
  45.     
  46.   begin
  47.     done := False;
  48.     repeat
  49.       WriteLn(Com);
  50.       st := prompt('Macro command <D><E><S><Q><?> ', 80, 'ES?');
  51.       if Length(st) = 1 then
  52.         ch := st[1]
  53.       else
  54.         ch := '?';
  55.       case ch of
  56.         'D' :
  57.           WriteLn(Com, macro);
  58.         'E' :
  59.           begin
  60.             continue := True;
  61.             Assign(macro_file, 'MACRO.LST');
  62.             {$I-}
  63.             Reset(macro_file); {$I+}
  64.             if IoResult = 0 then
  65.               begin
  66.                 WriteLn(Com);
  67.                 WriteLn(Com,
  68.                   'The MACRO.LST file exists and must be edited with a text editor.');
  69.                 continue := ask('do you want to edit the in-memory macro', 'Y');
  70.                 Close(macro_file);
  71.               end;
  72.             if continue then
  73.               begin
  74.                 WriteLn(Com, 'Remember, the edited macro is NOT saved to disk.');
  75.                 WriteLn(Com);
  76.                 ed_macro := macro;
  77.                 GetStr(ed_macro, ch, 79, 'ES');
  78.                 WriteLn(Com);
  79.                 macro := ed_macro;
  80.                 SetSect(HomName);
  81.               end;
  82.           end;
  83.         'S' :
  84.           begin
  85.             done := True;
  86.             Assign(macro_file, 'MACRO.LST');
  87.             {$I-}
  88.             Reset(macro_file); {$I+}
  89.             if IoResult = 0 then
  90.               begin
  91.                 if ask('Do you want to execute the MACRO.LST file', 'Y') then
  92.                   begin
  93.                     macro_file_exists := True;
  94.                     WriteLn('Starting macro execution.');
  95.                     macro_in_progress := True;
  96.                   end
  97.                 else
  98.                   Close(macro_file);
  99.               end;
  100.             if (not macro_file_exists) and (Length(macro) > 0) then
  101.               begin
  102.                 WriteLn('Starting macro execution.');
  103.                 macro_in_progress := True;
  104.                 st := macro;
  105.                 repeat
  106.                   i := Pos('^M', st);
  107.                   if i > 0 then
  108.                     begin
  109.                       Delete(st, i, 2);
  110.                       Insert(Chr(13), st, i);
  111.                     end;
  112.                 until i = 0;
  113.                 Cmd_Queue := st;
  114.                 mult_cmds := True;
  115.               end;
  116.           end;
  117.         'Q' :
  118.           done := True
  119.       else
  120.         WriteLn(Com, '<D>isplay, <E>dit, <S>tart, <Q>uit');
  121.       end;
  122.     until (done) or (not Online);
  123.   end;
  124.   
  125.   
  126.   
  127.   procedure process_newin;
  128.     { Process and update newin file (add, delete, edit, hide, and release) }
  129.     
  130.   var
  131.     ch, ch_sel      : Char;
  132.     x               : Integer;
  133.     rec             : LongInt;
  134.     Str             : StrTAD;
  135.     ed_descr, line  : StrStd;
  136.     Dirspec         : StrPr;
  137.     TmpDrv          : Str3;
  138.     temp_user_rec   : user_list;
  139.     fname, work,
  140.     junk            : DosFileName;
  141.     found,
  142.     none_found,
  143.     edited,
  144.     one_section     : Boolean;
  145.     fdrive          : Str3;
  146.     req, req_new    : string;
  147.     
  148.   begin
  149.     SetSect(HomName);
  150.     fname := '';
  151.     one_section := True;
  152.     none_found := True;
  153.     found := False;
  154.     rec := 0;
  155.     line := ' |---------- File Description -----------------------------------------------|';
  156.     work := 'NEWIN';
  157.     FindSect(work, TmpDrv, OK);
  158.     if OK then
  159.       begin
  160.         Dirspec := TmpDrv;
  161.         if (Length(HomName) > 3) and (Dirspec = HomDrv) then
  162.           begin
  163.             Dirspec := Dirspec+Copy(HomName, 4, Length(HomName));
  164.             Dirspec := Dirspec+'\';
  165.           end;
  166.         Dirspec := Dirspec+'NEWIN';
  167.         rec := Pred(FileSize(nwin_file));
  168.       end
  169.     else
  170.       WriteLn(Com, 'NEWIN section not found.');
  171.     WriteLn(Com);
  172.     if (OK) and (rec < 1) then
  173.       if (ask('File Empty: Add first Record', 'Y')) then
  174.         with nwin_rec do
  175.           begin
  176.             name := correct_fn(prompt('File name', 12, 'ES'));
  177.             if name <> '' then
  178.               begin
  179.                 while (Length(name)-Pos('.', name)) < 2 do
  180.                   name := name+'-';
  181.                 WriteLn(Com, line);
  182.                 descr := prompt('', 75, 'EL');
  183.                 GetTAD(date);
  184.                 user := user_loc;
  185.                 sectn := get_section_name('D');
  186.                 rec := FileSize(nwin_file);
  187.                 status := public;
  188.                 dnloads := 0;
  189.                 for x := 0 to 5 do
  190.                   last_dnload[x] := 0;
  191.                 rec := 1;
  192.                 Seek(nwin_file, rec);
  193.                 Write(nwin_file, nwin_rec);
  194.                 WriteLn(Com);
  195.                 WriteLn(Com, 'First Record recorded.');
  196.                 WriteLn(Com);
  197.               end;
  198.           end;
  199.           
  200.     if OK and (rec >= 1) and ask('Search by File(s)', 'N') then
  201.       fname := prompt('Enter filename  (partial name OK) ', 12, 'ES');
  202.     if (fname <> ' ') and (fname <> '') then
  203.       one_section := False;
  204.     if OK and (rec >= 1) and one_section and ask('Search by Section', 'N') then
  205.       fname := prompt('Enter Section name ', 12, 'ES');
  206.     abort := False;
  207.     while Online and OK and (rec >= 1) and (not brk) do
  208.       with nwin_rec do
  209.         begin
  210.           if (fname = '') or (fname = ' ') then
  211.             begin
  212.               Seek(nwin_file, rec);
  213.               Read(nwin_file, nwin_rec);
  214.             end
  215.           else
  216.             begin
  217.               found := False;
  218.               while OK and (rec >= 1) and (not found) and (not brk) and Online do
  219.                 begin
  220.                   Seek(nwin_file, rec);
  221.                   Read(nwin_file, nwin_rec);
  222.                   if (not one_section) then
  223.                     work := name
  224.                   else
  225.                     work := sectn;
  226.                   if Equal_names(fname, work) or (Pos(work, fname) = 1) then
  227.                     begin
  228.                       found := True;
  229.                       none_found := False;
  230.                     end
  231.                   else
  232.                     rec := Pred(rec);
  233.                 end;
  234.               if (not found) and (rec < 1) then
  235.                 begin
  236.                   OK := False;
  237.                   WriteLn(Com);
  238.                   if none_found then
  239.                     WriteLn(Com, 'File not found in Newin listings.');
  240.                 end;
  241.             end;
  242.           if OK then
  243.             begin
  244.               if (user > 0) and (user <= FileLen(DatF)) then
  245.                 begin
  246.                   GetRec(DatF, user, temp_user_rec);
  247.                   if temp_user_rec.used <> 0 then
  248.                     begin
  249.                       temp_user_rec.fn := 'Purged';
  250.                       temp_user_rec.ln := 'User';
  251.                     end;
  252.                 end
  253.               else
  254.                 begin
  255.                   temp_user_rec.fn := 'Unknown';
  256.                   temp_user_rec.ln := 'Sender';
  257.                 end;
  258.               WriteLn(Com);
  259.               case status of
  260.                 private :
  261.                   Write(Com, 'Hidden    ');
  262.                 public :
  263.                   Write(Com, 'Released  ');
  264.                 deleted :
  265.                   Write(Com, 'Deleted   ')
  266.               end;
  267.               Str := intstr(date[4], 2)+'/'+intstr(date[3], 2)+'/'+intstr(date[5], 2);
  268.               Write(Com, pad(name, 15), ' Section: ', sectn, ' ', Str, '  ');
  269.               WriteLn(Com, temp_user_rec.fn, ' ', temp_user_rec.ln);
  270.               Str := intstr(last_dnload[4], 2)+'/'+intstr(last_dnload[3], 2)+'/'+intstr(
  271.                 last_dnload[5], 2);
  272.               Write(Com, 'Number downloads ', dnloads, '  Last download ', Str);
  273.               if CreditType = Points then
  274.                 Write(Com, '   Points ', PointValue);
  275.               WriteLn(Com);
  276.               WriteLn(Com, descr);
  277.               edited := False;
  278.               repeat
  279.                 WriteLn(Com);
  280.                 st := prompt('Newin Command <A><D><E><H><P><R><U><M><Q><?> ', 80,
  281.                   'ES?');
  282.                 if st = ' ' then
  283.                   ch_sel := 'S'
  284.                 else if Length(st) = 1 then
  285.                   ch_sel := st[1]
  286.                 else
  287.                   ch_sel := '?';
  288.                 case ch_sel of
  289.                   'A' :
  290.                     begin
  291.                       name := correct_fn(prompt('File name', 12, 'ES'));
  292.                       if name <> '' then
  293.                         begin
  294.                           junk := name;
  295.                           FindKey(NewinName, rec, junk);
  296.                           if OK then
  297.                             begin
  298.                               WriteLn(Com);
  299.                               WriteLn(Com, 'File is already listed.');
  300.                               ch_sel := 'S';
  301.                             end
  302.                           else
  303.                             begin
  304.                               while (Length(name)-Pos('.', name)) < 2 do
  305.                                 name := name+'-';
  306.                               WriteLn(Com, line);
  307.                               descr := prompt('', 75, 'EL');
  308.                               GetTAD(date);
  309.                               user := user_loc;
  310.                               sectn := get_section_name('D');
  311.                               rec := FileSize(nwin_file);
  312.                               status := public;
  313.                               dnloads := 0;
  314.                               for x := 0 to 5 do
  315.                                 last_dnload[x] := 0;
  316.                             end;
  317.                         end
  318.                       else
  319.                         ch_sel := 'S';
  320.                     end;
  321.                   'D' :
  322.                     begin
  323.                       status := deleted;
  324.                       if ask('Delete file also', 'N') then
  325.                         begin
  326.                           FindSect(nwin_rec.sectn, fdrive, found);
  327.                           if found then
  328.                             begin
  329.                               if (fdrive = HomDrv) and (Length(HomName) > 3) then
  330.                                 req := HomName+'\'
  331.                               else
  332.                                 req := fdrive;
  333.                               req := req+nwin_rec.sectn+'\'+nwin_rec.name;
  334.                               req_new := DirSpec+'\'+nwin_rec.name;
  335.                               {$I-}
  336.                               Assign(temp_file, req_new);
  337.                               Erase(temp_file);
  338.                               if IoResult <> 0 then
  339.                                 begin
  340.                                   Assign(temp_file, req);
  341.                                   Erase(temp_file);
  342.                                   if IoResult <> 0 then
  343.                                     WriteLn(Com, 'File not found.');
  344.                                 end;
  345.                               {$I+}
  346.                             end;
  347.                         end;
  348.                     end;
  349.                   'E' :
  350.                     begin
  351.                       edited := True;
  352.                       WriteLn(Com);
  353.                       if ask('Change File name', 'N') then
  354.                         begin
  355.                           junk := name;
  356.                           DeleteKey(NewinName, rec, name);
  357.                           name := correct_fn(prompt('New File Name', 12, 'ES'));
  358.                           if name = '' then
  359.                             name := junk
  360.                           else
  361.                             junk := name;
  362.                           AddKey(NewinName, rec, junk);
  363.                           FlushIndex(NewinName)
  364.                         end;
  365.                       WriteLn(Com);
  366.                       WriteLn(Com, line);
  367.                       Write(Com, '  ');
  368.                       ed_descr := descr;
  369.                       GetStr(ed_descr, ch, 75, 'E');
  370.                       descr := ed_descr;
  371.                       WriteLn(Com);
  372.                       WriteLn(Com);
  373.                       Write(Com, 'Present section is ', sectn, '. ');
  374.                       if ask('Change it', 'N') then
  375.                         begin
  376.                           DeleteKey(NewinArea, rec, sectn);
  377.                           sectn := get_section_name('D');
  378.                           junk := sectn;
  379.                           AddKey(NewinArea, rec, junk);
  380.                           FlushIndex(NewinArea)
  381.                         end;
  382.                       if CreditType = Points then
  383.                         begin
  384.                           Write(Com, 'Present Point Value is ', PointValue, '. ');
  385.                           if ask('Change it', 'N') then
  386.                             begin
  387.                               PointValue := strint(prompt('Point Value ', 5, 'EL'));
  388.                             end;
  389.                         end;
  390.                     end;
  391.                   'H' :
  392.                     status := private;
  393.                   'R' :
  394.                     begin
  395.                       case CreditType of
  396.                         KiloBytes :
  397.                           begin
  398.                             PointValue := 0;
  399.                             FindSect(nwin_rec.sectn, fdrive, found);
  400.                             if found then
  401.                               begin
  402.                                 if (fdrive = HomDrv) and (Length(HomName) > 3) then
  403.                                   req := HomName+'\'
  404.                                 else
  405.                                   req := fdrive;
  406.                                 req := req+nwin_rec.sectn+'\'+nwin_rec.name;
  407.                                 req_new := DirSpec+'\'+nwin_rec.name;
  408.                                 {$I-}
  409.                                 Assign(temp_file, req_new);
  410.                                 Reset(temp_file);
  411.                                 if IoResult <> 0 then
  412.                                   begin
  413.                                     Assign(temp_file, req);
  414.                                     Reset(temp_file);
  415.                                     if IoResult <> 0 then
  416.                                       WriteLn(Com,
  417.                                         'File not found, filesize set to 0k..')
  418.                                     else
  419.                                       begin
  420.                                         if FileSize(temp_file) > 0 then
  421.                                           PointValue := FileSize(temp_file) div 1024;
  422.                                         Close(temp_file);
  423.                                       end;
  424.                                   end
  425.                                 else
  426.                                   begin
  427.                                     if FileSize(temp_file) > 0 then
  428.                                       PointValue := FileSize(temp_file) div 1024;
  429.                                     Close(temp_file);
  430.                                   end;
  431.                                 {$I+}
  432.                               end;
  433.                           end;
  434.                         Files :
  435.                           PointValue := 1;
  436.                       end;
  437.                       status := public;
  438.                       GetTAD(date);
  439.                       WriteLn(Com);
  440.                       if ask('Credit file to uploader', 'Y') then
  441.                         begin
  442.                           edit_user(temp_user_rec.fn, temp_user_rec.ln,
  443.                             PointValue);
  444.                         end;
  445.                     end;
  446.                   'P' :
  447.                     begin
  448.                       if (fname <> '') and (fname <> ' ') then
  449.                         begin
  450.                           found := False;
  451.                           abort := False;
  452.                           if rec < Pred(FileSize(nwin_file)) then
  453.                             Inc(rec);
  454.                           while OK and (rec < FileSize(nwin_file)) and Online and (not
  455.                             found) and (not brk) do
  456.                             begin
  457.                               Seek(nwin_file, rec);
  458.                               Read(nwin_file, nwin_rec);
  459.                               if (not one_section) then
  460.                                 work := Expand_Filename(nwin_rec.name)
  461.                               else
  462.                                 work := sectn;
  463.                               if Equal_names(fname, work) then
  464.                                 found := True
  465.                               else if rec < Pred(FileSize(nwin_file)) then
  466.                                 Inc(rec)
  467.                               else
  468.                                 OK := False;
  469.                             end;
  470.                         end
  471.                       else
  472.                         begin
  473.                           if rec < Pred(FileSize(nwin_file)) then
  474.                             Inc(rec)
  475.                           else
  476.                             OK := False;
  477.                         end;
  478.                     end;
  479.                   'S' :
  480.                     begin         {skip function dummy}
  481.                     end;
  482.                   'U' :
  483.                     begin
  484.                       edit_user(temp_user_rec.fn, temp_user_rec.ln, 0);
  485.                       WriteLn(Com);
  486.                     end;
  487.                   'M' :
  488.                     begin
  489.                       mesg_enter('M');
  490.                       WriteLn(Com);
  491.                     end;
  492.                   'Q' :
  493.                     OK := False;
  494.                 else
  495.                   WriteLn(Com,
  496.                     '<A>dd, <D>el, <E>dit, <H>ide, <P>rev, <R>elease, <U>ser Edit, <M>esg, <Q>uit')
  497.                 end;
  498.               until (ch_sel in ['A', 'D', 'E', 'H', 'P', 'R', 'S', 'M', 'U', 'Q']) or (not Online);
  499.               if ch_sel in ['A', 'D', 'H', 'R'] then
  500.                 begin
  501.                   if (ch_sel in ['H', 'R']) then
  502.                     begin
  503.                       SetSect(HomName); {set up for loading overlay}
  504.                       hide_release(name, status, Dirspec);
  505.                       SetSect(HomName); {re-set after using overlay}
  506.                     end;
  507.                   mode := files_mode; { enable all files to be read}
  508.                   ReadDir(DirEntries, DirSpace, DirBase);
  509.                   SetSect(HomName);
  510.                   mode := sysop_mode; {reset to current mode}
  511.                 end;
  512.               if (ch_sel in ['A', 'D', 'H', 'R']) or edited then
  513.                 begin
  514.                   Seek(nwin_file, rec);
  515.                   Write(nwin_file, nwin_rec);
  516.                   case ch_sel of
  517.                     'A' :
  518.                       begin
  519.                         WriteLn(Com, 'Newin Entry ADDED.');
  520.                         junk := sectn;
  521.                         AddKey(NewinArea, rec, junk);
  522.                         junk := name;
  523.                         AddKey(NewinName, rec, junk);
  524.                       end;
  525.                     'D' :
  526.                       WriteLn(Com, 'Newin Entry DELETED.');
  527.                     'H' :
  528.                       WriteLn(Com, 'Newin Entry marked HIDDEN.');
  529.                     'R' :
  530.                       WriteLn(Com, 'Newin Entry marked RELEASED.');
  531.                   end;
  532.                 end;
  533.               if (not(ch_sel in ['P', 'A', 'U', 'M'])) and (not edited) then
  534.                 rec := Pred(rec);
  535.             end;                  {ok}
  536.         end;                      {while}
  537.   end;
  538.   
  539.   
  540.   
  541.   procedure move_from_newin;
  542.     { Move aged files from Newin to appropriate area }
  543.     
  544.   var
  545.     rec             : Integer;
  546.     Dirspec,
  547.     NewDirspec      : StrPr;
  548.     TmpDrv          : Str3;
  549.     work            : DosFileName;
  550.     
  551.     
  552.     procedure make_path(var Dir : StrPr; section : DosFileName);
  553.     
  554.     begin
  555.       if (Length(HomName) > 3) and (Dir = HomDrv) then
  556.         begin
  557.           Dir := Dir+Copy(HomName, 4, Length(HomName));
  558.           Dir := Dir+'\'
  559.         end;
  560.       Dir := Dir+section;
  561.     end;
  562.     
  563.     
  564.     procedure check_dirs;
  565.     
  566.     var
  567.       This            : SectPtr;
  568.       TmpDirspec      : StrPr;
  569.       TmpSection      : DosFileName;
  570.       SameDrive       : Boolean;
  571.       
  572.     begin
  573.       This := SectBase;
  574.       while This <> nil do
  575.         begin
  576.           TmpSection := This^.SectName;
  577.           TmpDirspec := This^.SectDrive+':\';
  578.           if TmpDirspec = HomDrv then
  579.             SameDrive := True
  580.           else
  581.             SameDrive := False;
  582.           make_path(TmpDirspec, TmpSection);
  583.           if TmpSection <> 'SYSTEM' then
  584.             begin
  585.               if SameDrive then
  586.                 Delete(TmpDirspec, 1, 2);
  587.               {$I-}
  588.               ChDir(TmpDirspec) {$I+} ;
  589.               if IoResult = 0 then
  590.                 SetSect(HomName)
  591.               else
  592.                 MkDir(TmpDirspec);
  593.             end;
  594.           This := This^.Next;
  595.         end;
  596.     end;
  597.     
  598.     
  599.   begin
  600.     SetSect(HomName);
  601.     WriteLn(Com);
  602.     check_dirs;
  603.     if ask('Move files from the NEWIN section', 'Y') then
  604.       begin
  605.         rec := 1;
  606.         work := 'NEWIN';
  607.         FindSect(work, TmpDrv, OK);
  608.         if OK then
  609.           begin
  610.             Dirspec := TmpDrv;
  611.             make_path(Dirspec, work);
  612.             rec := Pred(FileSize(nwin_file))
  613.           end
  614.         else
  615.           WriteLn(Com, 'NEWIN section not found, aborting...');
  616.         WriteLn(Com);
  617.         OK := (rec > 1);
  618.         if OK then
  619.           with nwin_rec do
  620.             begin
  621.               WriteLn(Com, 'Moving files from NEWIN...Please wait...');
  622.               WriteLn(Com);
  623.               while rec > 1 do
  624.                 begin
  625.                   Seek(nwin_file, rec);
  626.                   Read(nwin_file, nwin_rec);
  627.                   FindSect(sectn, TmpDrv, OK);
  628.                   NewDirspec := TmpDrv;
  629.                   if OK then
  630.                     make_path(NewDirspec, sectn)
  631.                   else
  632.                     WriteLn(Com, name, ' shows invalid section name of ', sectn);
  633.                   if (day_diff(date[3], date[4], date[5]+1900, login_t[3], login_t[4],
  634.                     login_t[5]+1900) > new_days) and OK and (status <> private) and
  635.                   (status <> deleted) and ExistFile(Dirspec+'\'+name) then
  636.                     begin
  637.                       WriteLn(Com, 'Copying ', name, ' to ', sectn);
  638.                       errcode := ExecDos(CommandPath+' /C COPY '+Dirspec+'\'+name+' '+
  639.                         NewDirspec+' > nul', False, nil);
  640.                       if (not ExistFile(NewDirspec+'\'+name)) then
  641.                         WriteLn(Com, 'Copy wasn''t sucessful.')
  642.                       else if Dirspec = NewDirspec then
  643.                         WriteLn(Com, name, ' shows NEWIN as it''s area.')
  644.                       else
  645.                         begin
  646.                           WriteLn(Com, 'Deleting ', name);
  647.                           Assign(byte_file, Dirspec+'\'+name);
  648.                           Erase(byte_file)
  649.                         end;
  650.                     end;
  651.                   Dec(rec)
  652.                 end;
  653.             end;
  654.         mode := files_mode;
  655.         ReadDir(DirEntries, DirSpace, DirBase);
  656.         mode := sysop_mode;
  657.       end;
  658.   end;
  659.   
  660.   
  661. end.                              { of SYSOP3.PAS}
  662. 
  663.